{--------------------Straight from the type library--------------- WORDDEC.INC}
Const
// OlAttachmentType
    olByValue = 1;
    olByReference = 4;
    olEmbeddedItem = 5;
    olOLE = 6;
// OlDefaultFolders
    olFolderDeletedItems = 3;
    olFolderOutbox = 4;
    olFolderSentMail = 5;
    olFolderInbox = 6;
    olFolderCalendar = 9;
    olFolderContacts = 10;
    olFolderJournal = 11;
    olFolderNotes = 12;
    olFolderTasks = 13;
// OlFolderDisplayMode
    olFolderDisplayNormal = 0;
    olFolderDisplayFolderOnly = 1;
    olFolderDisplayNoNavigation = 2;
// OlInspectorClose
    olSave = 0;
    olDiscard = 1;
    olPromptForSave = 2;
// OlImportance
    olImportanceLow = 0;
    olImportanceNormal = 1;
    olImportanceHigh = 2;
// OlItems
    olMailItem = 0;
    olAppointmentItem = 1;
    olContactItem = 2;
    olTaskItem = 3;
    olJournalItem = 4;
    olNoteItem = 5;
    olPostItem = 6;
// OlSensitivity
    olNormal = 0;
    olPersonal = 1;
    olPrivate = 2;
    olConfidential = 3;
// OlJournalRecipientType;
    olAssociatedContact = 1;
// OlMailRecipientType;
    olOriginator = 0;
    olTo = 1;
    olCC = 2;
    olBCC = 3 ;

Const
    wdGoToBookmark = -1;
    wdGoToSection = 0;
    wdGoToPage = 1;
    wdGoToTable = 2;
    wdGoToLine = 3;
    wdGoToFootnote = 4;
    wdGoToEndnote = 5;
    wdGoToComment = 6;
    wdGoToField = 7;
    wdGoToGraphic = 8;
    wdGoToObject = 9;
    wdGoToEquation = 10;
    wdGoToHeading = 11;
    wdGoToPercent = 12;
    wdGoToSpellingError = 13;
    wdGoToGrammaticalError = 14;
    wdGoToProofreadingError = 15;

    wdGoToFirst = 1;
    wdGoToLast = -1;
    wdGoToNext = 2;   //this is interesting
    wdGoToRelative = 2;  //how can these two be the same
    wdGoToPrevious = 3;
    wdGoToAbsolute = 1;

Function GetWordUp(StartType : string):Boolean;
Function InsertPicture(AFileName : String) : Boolean;
Function InsertContactInfo(MyId : TMyId; MyContId : TMyContId): Boolean;
Function GetOutlookUp(ItemType : Integer): Boolean;
Function MakeOutLookContact(MyId : TMyId; MyContId : TMyContId) : Boolean;
Function ImportOutlookContact : Boolean;
Function GetOutlookFolderItemCount : Integer;
Function GetThisOutlookItem(AnIndex : Integer) : Variant;
Function FindMyOutlookItem(AFilter : String; var AItem : Variant) :Boolean;
Function FindNextMyOutlookItem(var AItem : Variant) : Boolean;
Function CloseOutlook : Boolean;

Type TTreeData = class(TObject)
   Public
     ItemId : String;
end;

{$I worddec.inc} {literal crap translated from type libraries}

Var
  myRegistry : TRegistry;
  GotWord : Boolean;
  WhereIsWord : String;
  WordDoneMessage : Integer;
  Basically : variant;
  Wordy: Variant;
  MyDocument : Variant;
  MyOutlook : Variant;
  MyNameSpace : Variant;
  MyFolder : Variant;
  MyAppointment : Variant;



Function GetWordUp(StartType : string):Boolean;
// to start word the "right" way for me
// if you start word, you own word and I wanted it to remain after I closed
var   i : integer;
      AHwnd : Hwnd;
      AnAnswer : Integer;
      temp : string;
      MyDocumentsCol : Variant;
      TemplatesDir : Variant;
      OpenDialog1 : TopenDialog;

begin
       result := false;
       myRegistry := Tregistry.Create;
       myRegistry.RootKey := HKEY_LOCAL_MACHINE;
// no word 8, no function
       If myRegistry.KeyExists('SOFTWARE\Microsoft\Office\8.0\Word')
          then
              GotWord := true
          Else
              GotWord := false;
       If GotWord then
//where the heck is it?
          If myRegistry.OpenKey('SOFTWARE\Microsoft\Office\8.0', false) then
              begin
                 WhereisWord := myRegistry.ReadString('BinDirPath');
                 MyRegistry.CloseKey;
              end
          else
              GotWord := false;
       If GotWord then
//where are those pesky templates?
          Begin
             MyRegistry.RootKey := HKEY_CURRENT_USER;
             If 
myRegistry.OpenKey('SOFTWARE\Microsoft\Office\8.0\Common\FileNew\SharedTemplates', false) then
                Begin
                   TemplatesDir := myRegistry.ReadString(Nothing);
                   MyRegistry.CloseKey;
                end
             Else
                Begin
                   Warning('Ole setup','The workgroup templates have not been setup');
                   GotWord := false;
                end;
           End;
       myRegistry.free;
       If not gotword then
          Begin
              Warning('Ole Handler', 'Word is not installed');
              exit;
          end;
//this is the class name for the last two versions of word's main window
       temp := 'OpusApp';
       AHwnd :=  FindWindow(pchar(temp),nil);
       If (AHwnd = 0) then
//it isn't running and I don't wanna start it by automation
           Begin
              Temp := WhereisWord + '\winword.exe /n';
              AnAnswer := WinExec(pchar(temp), 1);
              If (AnAnswer < 32) then
                 Begin
                    Warning('Ole Handler', 'Unable to find WinWord.exe');
                    Exit;
                 End;
           End;

    Application.ProcessMessages;
{If you use Word.Application, you get your own instance}
{If you use Word.Document, you get the running instance}
{this makes a trash document (for me, anyway) and I chuck it out later}
    try {and make a new document} 
         Basically := CreateOleObject('Word.Document.8');
       except
         Warning('Ole Handler', 'Could not start Microsoft Word.');
         Result := False;
         Exit;
       end;
    Try {get the app variant from that new document}
         Wordy := Basically.Application;
       Except
           Begin
              Warning('Ole Handler', 'Could not access Microsoft Word.');
              Wordy := UnAssigned;
              Basically := UnAssigned;
              Exit;
           end;
       end;

    Application.ProcessMessages;

    Wordy.visible := false;
    MyDocumentsCol := Wordy.Documents;
{If its just my throw away document or I wanted a brand new one}
    If (MyDocumentsCol.Count = 1) or
       (StartType = 'New') then
        Begin
          OpenDialog1 := TOpenDialog.Create(Application);
          OpenDialog1.filter := 'WordTemplates|*.dot|Word Documents|*.doc';
          OpenDialog1.DefaultExt := '*.dot';
          OpenDialog1.Title := 'Select your template';
          OpenDialog1.InitialDir := TemplatesDir;
          If OpenDialog1.execute then
             Begin
                Wordy.ScreenUpdating:= false;
                MyDocumentsCol := wordy.Documents;
                MyDocumentsCol.Add(OpenDialog1.Filename, False);
                OpenDialog1.free;
             end
          Else
             begin
                OpenDialog1.Free;
                Wordy.visible := true;
                Wordy := Unassigned;
                Basically := Unassigned;
                Exit;
             end;
       end
  Else
{get rid of my throwaway}
      MyDocument.close(wdDoNotSaveChanges); 

{now I either have a new document based on a template the user selected
 or I have their current document}
   MyDocument := Wordy.ActiveDocument;
   Result := true;
   Application.ProcessMessages;

end;

Function InsertPicture(AFileName : String) : Boolean;
var
  MyShapes : Variant;
  MyRange : variant;

begin
   Result := True;
   If GetWordUp('Current')then
   Try
      Begin
           MyRange := MyDocument.Goto(wdgotoline, wdgotolast);
           MyRange.EndOf(wdParagraph, wdMove);
           MyRange.InsertBreak(wdPageBreak);
           MyShapes := MyDocument.InlineShapes;
           MyShapes.AddPicture(afilename, false, true, MyRange);
      end;
   Finally
      begin
        Wordy.ScreenUpdating:= true;
        Wordy.visible := true;
        Wordy := Unassigned;
        Basically := UnAssigned;
        Application.ProcessMessages;
      end;
   end
   else
       Result := False;

end;

Function InsertContactInfo(MyId : TMyId; MyContId : TMyContId) : Boolean;
var
  MyCustomProps : Variant;
begin
{ personally, I store stuff in document properties and then give out a
toolbar macro to allow the user to "set" the properties in their template or current
document.

this has three advantages that I know of (and no defects that I'm aware of)
1.  The user can place the location of the info in the document either
before or after this function runs
2.  A custom property can be placed any number of times inside the same
document
3.  A user can map the properties in their Outlook or search on them using
that abismal file open in Word}


   Result := true;
   If GetWordUp('New')then
   Try
      Begin
           MyCustomProps := MyDocument.CustomDocumentProperties;
           MyCustomProps.add(cpId, false, msoPropertyTypeString, MyId.Id);
           MyCustomProps.add(cpOrganizationName,
		      false, msoPropertyTypeString, MyId.OrganizationName);
           MyCustomProps.add(cpAddress1,
		      false, msoPropertyTypeString,MyId.Address1);
           MyCustomProps.add(cpAddress2, false,
		      msoPropertyTypeString, MyId.Address2);
           MyCustomProps.add(cpCity, false,
		      msoPropertyTypeString, MyId.City);
           MyCustomProps.add(cpStProv, false,
		      msoPropertyTypeString, MyId.StProv);
           MyCustomProps.add(cpCountry,
		      false, msoPropertyTypeString,MyId.City);
           MyCustomProps.add(cpPostal, false,
		      msoPropertyTypeString, MyId.Country);
           MyCustomProps.add(cpAccountId, false,
		      msoPropertyTypeString, MyId.AccountId);
           MyCustomProps.add(cpFullName, false,
		      msoPropertyTypeString, MyContId.FullName);
           MyCustomProps.add(cpSalutation, false,
		      msoPropertyTypeString, MyContId.Salutation);
           MyCustomProps.add(cpTitle, false,
		      msoPropertyTypeString,MyContId.Title);
           If (MyContId.workPhone = Nothing) or
		      (MycontId.WorkPhone = ASpace) then
               MyCustomProps.add(cpPhone, false,
			      msoPropertyTypeString, MyId.Phone )
           else
               MyCustomProps.add(cpPhone, false,
			      msoPropertyTypeString, MyContId.WorkPhone );
           If (MyContId.Fax = Nothing) or (MycontId.Fax = ASpace) then
               MyCustomProps.add(cpFax, false,
			      msoPropertyTypeString, MyId.Fax)
           else
               MyCustomProps.add(cpFax, false,
                  msoPropertyTypeString,MyContId.Fax);
           If (MyContId.EMail = Nothing) or (MycontId.Email = ASpace) then
               MyCustomProps.add(cpEmail, false,
			      msoPropertyTypeString, MyId.Email)
           else
               MyCustomProps.add(cpEmail, false,
			      msoPropertyTypeString, MyContId.Email);
           MyCustomProps.add(cpFirstName, false,
               msoPropertyTypeString,MyContId.FirstName);
           MyCustomProps.add( cpLastName, false,
		      msoPropertyTypeString, MyContId.LastName);
           MyDocument.Fields.Update;
      end;
   Finally
      begin
        Wordy.ScreenUpdating:= true;
        Wordy.visible := true;
        Wordy := Unassigned;
        Basically := UnAssigned;
        Application.ProcessMessages;
      end;
   end
   Else
      Result := false;
end;

Function GetOutlookUp(ItemType : Integer): Boolean;
Const
    AppointmentItem = 'Calendar';
    TaskItem = 'Tasks';
    ContactItem = 'Contacts';
    JournalItem = 'Journal';
    NoteItem = 'Notes';
var
     MyFolders : Variant;
     MyFolders2 : variant;
     MyFolders3 : variant;
     MyFolder2 : Variant;
     MyFolder3 : variant;
     MyUser : Variant;
     MyFolderItems : Variant;
     MyFolderItems2 : Variant;
     MyFolderItems3 : Variant;
     MyContact : Variant;
     i, i2, i3 : Integer;
     MyTree : TCreateCont;
     MyTreeData : TTreeData;
     RootNode, MyNode, MyNode2 : ttreeNode;
     ThisName : String;

Begin
    {this is really ugly........
     There is some really wierd thing going on in the object model for outlook
     so excuse this folder.folder.folder stuff cause the "right way" doesn't work
     for folders and this does}

{user picks folder from treeview}

     Result := False;
     Case ItemType of
         olAppointmentItem : ThisName := AppointmentItem;
         olContactItem : ThisName := ContactItem;
         olTaskItem : ThisName := TaskItem;
         olJournalItem : ThisName := JournalItem;
         olNoteItem : ThisName := NoteItem;
     Else
         ThisName := 'Unknown';
     End;

     try
           MyOutlook := CreateOleObject('Outlook.Application');
        except
           warning('Ole Interface','Could not start Outlook.');
           Exit;
        end;
    {this is the root folder} 
    MyNameSpace := MyOutlook.GetNamespace('MAPI');
    MyFolderItems := MyNameSpace.Folders;
    MyTree := TCreateCont.create(Application);
{Really unfortunate, but a user can create something other than the default
folder for the kind of thing you're interested in - so this goes down a coupla
levels in the folder chain}
    MyTree.Caption := 'Select ' + ThisName + ' Folder';
    With MyTree do
         If MyFolderItems.Count > 0 then
            For i := 1 to MyFolderItems.Count do begin
                MyFolder := MyNameSpace.Folders(i);
                MyTreeData := TTreeData.create;
                MyTreeData.ItemId := MyFolder.EntryId;
                RootNode := TreeView1.Items.AddObject(nil, MyFolder.Name, MyTreeData);
                MyFolders2 := MyNameSpace.folders(i).Folders;
                If MyFolders2.Count > 0 then
                   for i2 := 1 to MyFolders2.Count do begin
                       MyFolder2 := MyNameSpace.folders(i).Folders(i2);
                       If (MyFolder2.DefaultItemType = ItemType)
                           or (MyFolder2.Name = ThisName) then
                               Begin
                                    MyTreeData := TTreeData.create;
                                    MyTreeData.ItemId := MyFolder2.EntryId;
{this is what you need to directly point at the folder}
                                    MyNode :=
Treeview1.Items.addChildObject(RootNode, MyFolder2.Name, MyTreeData);
                                    MyFolders3 :=
MyNameSpace.folders(i).Folders(i2).Folders;
                                    If MyFolders3.Count > 0 then
                                       for i3 := 1 to MyFolders3.Count do
				   begin
                                           MyFolder3 := MyNameSpace.folders(i).Folders(i2).Folders(i3);
                                           If (MyFolder3.DefaultItemType = ItemType) then
                                               Begin
                                                    MyTreeData := TTreeData.create;
                                                    MyTreeData.ItemId := MyFolder3.EntryId;
                                                    MyNode2 :=
Treeview1.Items.addChildObject(MyNode, MyFolder3.Name, MyTreeData);
                                               end;
                                       end;
                               end;
                   end;
         end;
       If MyTree.TreeView1.Items.Count = 2 then
{there is only the root and my designated folder}
          MyFolder :=
MyNameSpace.GetFolderFromID(TTreeData(MyTree.TreeView1.Items[1].Data).ItemId
)
       Else
          begin
              MyTree.Treeview1.FullExpand;
              MyTree.ShowModal;
              If MyTree.ModalResult = mrOk then
                 Begin
                      If MyTree.Treeview1.Selected <> nil then
                         MyFolder :=
MyNameSpace.GetFolderFromID(TTreeData(MyTree.Treeview1.Selected.Data).ItemId
);
                 end
              else
                 Begin
                     MyOutlook := UnAssigned;
                     For i:= MyTree.Treeview1.Items.Count -1 downto 0 do
                         TTreeData(MyTree.Treeview1.Items[i].Data).free;
                     MyTree.release;
                     exit;
                 end;
          end;
       For i:= MyTree.Treeview1.Items.Count -1 downto 0 do
           TTreeData(MyTree.Treeview1.Items[i].Data).free;
       MyTree.release;
       Result := true;
end;

Function MakeOutlookContact(MyId : TMyId; MyContId : TMyContId) : boolean;
var      MyContact : Variant;
begin
       Result := false;
       If not GetOutlookUp(OlContactItem)
          then exit;
       MyContact := MyFolder.Items.Add(olContactItem);
       MyContact.Title := MyContId.Honorific;
       MyContact.FirstName := MyContId.FirstName;
       MyContact.MiddleName := MycontId.MiddleInit;
       MyContact.LastName :=  MycontId.LastName;
       MyContact.Suffix := MyContId.Suffix;
       MyContact.CompanyName := MyId.OrganizationName;
       MyContact.JobTitle := MyContId.Title;
       MyContact.OfficeLocation := MyContId.OfficeLocation;
       MyContact.CustomerId := MyId.ID;
       MyContact.Account := MyId.AccountId;
       MyContact.BusinessAddressStreet := MyId.Address1 + CRLF + MyId.Address2;
       MyContact.BusinessAddressCity := MyId.City;
       MyContact.BusinessAddressState := MyId.StProv;
       MyContact.BusinessAddressPostalCode := MyId.Postal;
       MyContact.BusinessAddressCountry := MyId.Country;
       If (MyContId.Fax = Nothing) or (MyContId.Fax = ASpace) then
          MyContact.BusinessFaxNumber := MyId.Fax
       Else
          MyContact.BusinessFaxNumber := MyContId.Fax;
       If (MyContId.WorkPhone = Nothing) or (MyContId.WorkPhone = ASpace)
then
          MyContact.BusinessTelephoneNumber := MyId.Phone
       Else
          MyContact.BusinessTelephoneNumber := MyContId.WorkPhone;
       MyContact.CompanyMainTelephoneNumber := MyId.Phone;
       MyContact.HomeFaxNumber := MyContId.HomeFax;
       MyContact.HomeTelephoneNumber := MyContId.HomePhone;
       MyContact.MobileTelephoneNumber := MyContId.MobilePhone;
       MyContact.OtherTelephoneNumber := MyContId.OtherPhone;
       MyContact.PagerNumber := MyContId.Pager;
       MyContact.Email1Address := MyContId.Email;
       MyContact.Email2Address := MyId.Email;
       Result := true;
       Try MyContact.Save;
       Except
           Result := false;
       end;
       MyOutlook := Unassigned;

end;

Function GetThisOutlookItem(AnIndex : Integer) : Variant;
Begin
  Result := myFolder.Items(AnIndex);
end;

Function GetOutlookFolderItemCount : Integer;
Var myItems : Variant;
Begin
    Try MyItems := MyFolder.Items;
      Except
         Begin
            Result := 0;
            exit;
         end;
      end;
    Result := MyItems.Count;
end;

Function FindMyOutlookItem(AFilter : String; var AItem : Variant) :
Boolean;
Begin
{this is another real PAIN - nil variant}
       Result := true;
       Try
          AItem := myFolder.Items.Find(AFilter);
       Except
          Begin
             aItem := MyFolder;
             Result := false;
          end;
       End;

End;

Function FindNextMyOutlookItem(var AItem : Variant) : Boolean;
Begin
       Result := true;
       Try
          AItem := myFolder.Items.FindNext;
       Except
          Begin
             AItem := myFolder;
             Result := false;
          end;
       End;
End;


Function CloseOutlook : Boolean;
begin
       Try MyOutlook := Unassigned;
       Except
       End;
       Result := true;

end;

unit UImpContact;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  UMain, StdCtrls, Buttons, ComCtrls, ExtListView;

type
  TFindContact = class(TForm)
    ContView1: TExtListView;
    SearchBtn: TBitBtn;
    CancelBtn: TBitBtn;
    procedure SearchBtnClick(Sender: TObject);
    procedure CancelBtnClick(Sender: TObject);
    procedure ContView1DblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FindContact: TFindContact;

implementation
Uses USearch;

{$R *.DFM}

procedure TFindContact.SearchBtnClick(Sender: TObject);
begin
   If ContView1.Selected <> nil then
      ContView1DblClick(nil);
end;

procedure TFindContact.CancelBtnClick(Sender: TObject);
begin
    CloseOutlook;
    ModalResult := mrCancel;
end;

procedure TFindContact.ContView1DblClick(Sender: TObject);
var MyContact : variant;
begin
   If ContView1.Selected <> nil then Begin
         MyContact := GetThisOutlookItem(StrToInt(ContView1.Selected.subitems[2]));
         With StartForm.MyId do
            If Not GetData(MyContact.CustomerId) then begin
               InitData;
               If MyContact.CustomerId <> '' then
                  Id := MyContact.CustomerId
               Else
                  Id := MyContact.CompanyName;
               If DoesIdExist(Startform.MyId.Id) then begin
                  Warning('Data Handler', 'Can not establish unique Id' + CRLF
                          + 'Edit CustomerId in Outlook and then try again');
                  CloseOutlook;
                  ModalResult := mrCancel;
                  Exit;
                  end;
               OrganizationName := MyContact.CompanyName;
               IdType := 1;
               AccountId := MyContact.Account;
               Address1 := MyContact.BusinessAddressStreet;
               City := MyContact.BusinessAddressCity;
               StProv := MyContact.BusinessAddressState ;
               Postal := MyContact.BusinessAddressPostalCode;
               Country := MyContact.BusinessAddressCountry;
               Phone := MyContact.CompanyMainTelephoneNumber;
               Insert;
               end;
         With StartForm.MyContId do begin
               InitData;
               ContIdId := StartForm.MyId.Id;
               Honorific := MyContact.Title ;
               FirstName := MyContact.FirstName ;
               MiddleInit := MyContact.MiddleName ;
               LastName :=  MyContact.LastName ;
               Suffix := MyContact.Suffix ;
               Fax :=    MyContact.BusinessFaxNumber ;
               WorkPhone :=   MyContact.BusinessTelephoneNumber;
               HomeFax := MyContact.HomeFaxNumber ;
               HomePhone := MyContact.HomeTelephoneNumber ;
               MobilePhone := MyContact.MobileTelephoneNumber ;
               OtherPhone := MyContact.OtherTelephoneNumber ;
               Pager := MyContact.PagerNumber ;
               Email := MyContact.Email1Address ;
               Title := MyContact.JobTitle;
               OfficeLocation := MyContact.OfficeLocation ;
               Insert;
               End;
   end;
CloseOutlook;
ModalResult := mrOk;

end;

procedure TFindContact.FormCreate(Sender: TObject);
var      MyContact : Variant;
         MyCount : Integer;
         i : Integer;
         AnItem : TListItem;
begin
   If not GetOutlookUp(OlContactItem)
      then exit;
   MyCount := GetOutlookFolderItemCount ;
   For i := 1 to MyCount do begin
        MyContact := GetThisOutlookItem(i);
        AnItem := ContView1.Items.Add;
        AnItem.Caption := MyContact.CompanyName;
        AnItem.SubItems.add(MyContact.FirstName);
        AnItem.Subitems.Add(MyContact.LastName);
        AnItem.SubItems.Add(inttostr(i));
   End;

end;

procedure TFindContact.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
    Action := cafree;
end;

end.

OLE Tester

From: johan@lindgren.pp.se

This creates the oleobject upon creation and then whenever you press a button it calls a procedure in the oleserver.

unit oletestu;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
     ttsesed : variant;
  end;

var
  Form1: TForm1;

implementation
uses oleauto;
{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  ttsesed := createoleobject('ttdewed.ttsesole');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ttsesed.openeditfile;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ttsesed.appshow;
end;

end.

Getting data from Delphi app into Word document

From: Darek Maluchnik <embrio@plearn.edu.pl>

Try:

Declare Function StringFromDelphi  Lib "c:\sample\test.dll" As String

Sub MAIN
mystring$ = StringFromDelphi
Insert mystring$
End Sub

library Test;  (* test.dpr in c:\sample *)
uses Testform in 'TESTFORM.PAS';
exports
    StringFromDelphi;
begin
end.

unit Testform; (* testform.pas in c:\sample *)
interface
uses
WinTypes, WinProcs, Forms, Classes, Controls, StdCtrls, SysUtils;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  end;
var
  Form1: TForm1;

function StringFromDelphi : PChar; export;
                     {$ifdef WIN32} stdcall; {$endif}

implementation
{$R *.DFM}

function StringFromDelphi: Pchar;
var StringForWord : array[0..255] of char;
begin
    Application.CreateForm(TForm1, Form1);
    Form1.ShowModal;
    Result:=StrPCopy(StringForWord, Form1.Button1.caption);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    close;
end;

end.

There is a text in PCMagazine Vol12.No22 on accessing DLL functions from Word. You can get it (DLLACCES) from PCMag web site.

WordBasic via OLE

Try the following:

MsWord := CreateOleObject('Word.Basic');
MsWord.FileNewDefault;
MsWord.TogglePortrait;

Creating Word Documents

I have found the following works well D2 -> Word 97, using "Bookmark" fields in Word.

..
..
..

implementation

uses OleAuto;
..
..
..
var  
   V : Variant ;

..
..
..
   V := 0; // at some point just to initialise

..
..
.. some functions
            

   if V = 0 then
   begin
      V := CreateOLEObject('Word.Application');
      V.WordBasic.AppShow;
   end;

   // this example assumes we are filling in some bookmark
   // fields on a "standard letter", from a query that has previously
   // been executed, in a data module called pnm_data (OK , should
   // have used a with...block !)
   V.WordBasic.Fileopen('Your Word Doc name');
   V.WordBasic.EditBookmark('Title',0,0,0,1);
   V.WordBasic.Insert(Title);
   V.WordBasic.EditBookmark('FirstName',0,0,0,1);
   V.WordBasic.Insert(FirstName + ' ');
   V.WordBasic.EditBookmark('LastName',0,0,0,1);
   V.WordBasic.Insert(pnm_data.ContactsQuery1Fam_Name.AsString + ' ');
   V.WordBasic.EditBookmark('Address1',0,0,0,1);
   V.WordBasic.Insert(pnm_data.ContactsQuery1Address1.AsString + ' ');
   V.WordBasic.EditBookmark('Address2',0,0,0,1);
   V.WordBasic.Insert(pnm_data.ContactsQuery1Address2.AsString + ' ');
   V.WordBasic.EditBookmark('Address3',0,0,0,1);
   V.WordBasic.Insert(pnm_data.ContactsQuery1Address3.AsString + ' ');
   V.WordBasic.EditBookmark('Title1',0,0,0,1);
   V.WordBasic.Insert(Title);
   V.WordBasic.EditBookmark('LastName1',0,0,0,1);
   V.WordBasic.Insert(pnm_data.ContactsQuery1Fam_Name.AsString + ' ');

   (You could V.WordBasic.PrintDefault; if you want to tell Word
   to print it as well....and many other commands, like saving, changing
   font etc can be done)

   ....etc

Starting Word without AutoStart Macro

To disable the AutoOpen Macro, you can execute this command

WordBasic.DisableAutoMacros

Wordbasic from Delphi using Parameters

Function TAutoMerge.ProcessMerge(FSource, FData, FOutput : string) :
boolean;
var
   MSWord  : Variant;
   i, NumDocs : integer;
   Found : boolean;
   s, LastOLECommand : string;
begin
   ProcessMerge := False;
   try
     LastOLECommand := 'Creating OLE Object.';
     MSWord := CreateOLEObject('Word.Basic');
     LastOLECommand := 'Show MS Word.';
     MSWord.AppShow;
     Application.ProcessMessages;

     LastOLECommand := 'Open document file >' + FSource + '<.';
     MSWord.FileOpen(Name := FSource, ConfirmConversions := 0,
                    ReadOnly := 1, AddToMru := 0, PasswordDoc := '',
                    PasswordDot := '', Revert := 0,
					WritePasswordDoc := '',
                    WritePasswordDot := '');
     LastOLECommand := 'Screen updating = false.';
     MSWord.ToolsOptionsSpelling(AutomaticSpellChecking := 0);    
     LastOLECommand := 'Set background printing to off.';
     MSWord.ToolsOptionsPrint(Background := 0);
 
     Application.ProcessMessages;
     LastOLECommand := 'Open Data file >' + FData + '<.';
     MSWord.MailMergeOpenDataSource(Name := FData, ConfirmConversions := 0,
                                    ReadOnly := 1, LinkToSource := 1,
									AddToMru := 0,
                                    PasswordDoc := '', PasswordDot := '',
                                    WritePasswordDoc := '', WritePasswordDot := '',
                                    Connection := '', SQLStatement := '',
									SQLStatement1 := '',
                                    Revert := 1);

     LastOLECommand := 'Start the Mail Merge.';
     MSWord.MailMerge(CheckErrors := 2, Destination := 1,
	                  MergeRecords:= 0,
                      From := '', To := '', Suppression := 0, 
                      MailSubject := '',
                      MailAsAttachment := 0, MailAddress := '');

     LastOLECommand := 'Set up for SendKeys to select printer.';
     Application.ProcessMessages;
     MSWord.AppShow;
     s := '{home}%l{enter}{home}%n' + FOutput + '{tab}{enter}{home}{enter}';
                           // sdd 1.1
     MSWord.SendKeys(s, -1);
     MSWord.MailMergeToPrinter;
     Application.ProcessMessages;

     ProcessMerge := True;
     LastOLECommand := 'All done with merge.';
   except
     on EOleException do
       begin
         inc(TotalOLEErrors);
         lblStatus.caption := LastOLECommand;
         if (TotalOLEErrors >= TOTALOLEERRORS_MAX) then
            begin
              s := 'There has been at least one OLE error(' +
IntToStr(TotalOLEErrors) +
                   '), the last one was >' + LastOLECommand + '<.';
              ShowMessage(s);
            end;
       end
   end;
end;

  var
     Word: Variant;
  begin
     Word := CreateOleObject('Word.Basic');
     with Word do
        begin {Pure WordBASIC commands follow...}
        FileNew('Normal');
        Insert('This is the first line'#13);
        Insert('This is the second line'#13);
        FileSaveAs('c:\temp\test.txt', 3);
        end;
  end;

procedure TfrmBlank.btnExcelClick(Sender: TObject);
var
   XL, XArr: Variant;
   i : Integer;
   j : Integer;
begin
     {note the ComObj (example OleAuto not correct) in the uses}
     // Create an array of query element size
     XArr:=VarArrayCreate([1,EmailQuery.FieldCount],varVariant);
     XL:=CreateOLEObject('Excel.Application');     // Ole object creation
     XL.WorkBooks.add;
     XL.visible:=true;
     
     j := 1;
     EmailQuery.First;
     while not EmailQuery.Eof do begin
           i:=1;
           while i<=EmailQuery.FieldCount do begin
                 XArr[i] := EmailQuery.Fields[i-1].Value;
                 i := i+1;
           end;
           XL.Range['A'+IntToStr(j),
	           CHR(64+EmailQuery.FieldCount)+IntToStr(j)].Value := XArr;
           EmailQuery.Next;
           j := j + 1;
     end;
     XL.Range['A1',CHR(64+EmailQuery.FieldCount)+IntToStr(j)].select;
     // XL.cells.select;                     // Select everything
     XL.Selection.Font.Name:='Garamond';
     XL.Selection.Font.Size:=10;
     XL.selection.Columns.AutoFit;
     XL.Range['A1','A1'].select;
end;

unit oleword;
// Need a form with a button, memo, and edit component.
// Written for MSWord 8.
// Also need to create a test document d:\test.doc
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
OLEAuto, ShellAPI, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Edit1: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
       MSWord: Variant;
   // WordVersion: Byte;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var Test, Test1:  Integer;
     AString: Variant;
begin
   MSWord := CreateOLEObject('Word.Application');     //Word 8
   MSWord.Documents.Open (FileName:='d:\test.doc', ReadOnly:=True);
   MSWord.Visible := 1;         //Uncomment if you wish to show the file;
   Test := MSWord.FontNames.Count;
    For Test1 := 1 To Test  do
      begin
      AString := MSWord.FontNames.Item(Test1) ;
      Memo1.Lines.Add(AString);
      end;
      MSWord.ActiveDocument.Range(Start:=0, End:=0);
      MSWord.ActiveDocument.Range.InsertAfter(Text:='Title');
      MSWord.ActiveDocument.Range.InsertParagraphAfter;
      MSWord.ActiveDocument.Range.Font.Name := 'Arial';
      MSWord.ActiveDocument.Range.Font.Size := 24;
      AString := MSWord.ActiveDocument.Range.Font.Name;
      Edit1.Text := AString;
end;

end.